unit TBCommon;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, System.Types, Winapi.ShlObj,
  Winapi.ActiveX, System.Math, Data.Win.ADODB, Data.DB,
  Datasnap.DBClient, Winapi.WinSock, System.AnsiStrings, Winapi.WinInet,
  System.Variants, System.Win.ComObj, Winapi.ADOInt, Datasnap.Provider;

function GMTNow: TDateTime;
function LocaleToGMT(const Value: TDateTime): TDateTime;
function GMTToLocale(const Value: TDateTime): TDateTime;
procedure FreeAndNilEx(var Obj);
function DataToHex(Data: PChar; Len: integer): string;
function IsFileInUse(AName: string): Boolean;
function GetLastErrorText: string;
function GetADOLastErrorText(AdoConn: TAdoConnection): string;
function Encrypt(Src: AnsiString; Key: AnsiString): AnsiString;
function Decrypt(Src: AnsiString; Key: AnsiString): AnsiString;
function UnicodeToAnsi(const Src: WideString; CodePage: Word=0): AnsiString;
function AnsiToUnicode(const Src: AnsiString; CodePage: Word=0): WideString;
Function IsIPInstalled : Boolean;
function GetIPFromName(AHostName: AnsiString; var IP: Ansistring): Boolean;
function GetNameFromIP(IPAddr: AnsiString; var MacName: AnsiString): Boolean;
Function LanConnected: Boolean;
function InternetConnected: Boolean;
function UDPPortInuse(Port: integer): Boolean;
function TCPPortInuse(Port: integer): Boolean;
function GetRandomUDPPort(RangeMin: integer; RangeMax: integer): Integer;
function GetRandomTCPPort(RangeMin: integer; RangeMax: integer): Integer;
function GetLocalIP(): AnsiString;
function GetComputerName: String;
function GetLocalIpList(var IpList: TStringList):Integer;
function IsValidIP(aStrIP: AnsiString): Boolean;
function HostIsOnline(IpAddr: string): Boolean;
function GetConnectionKind: integer;
procedure DeleteDirectory(sDir: String);
function VariantToStream (const v: OleVariant; Stream: TMemoryStream): boolean;
function StreamToVariant(Stream: TMemoryStream; var v: OleVariant): boolean;
function RecordsetToStream(const RecordSet: _Recordset; var Stream: TMemoryStream): boolean;
function StreamToRecordSet(Stream: TMemoryStream; var RecordSet: _Recordset): boolean;
function DataSetToCdsData(aDataset: TDataSet): OleVariant;
function GetCdsFromAdo(aAdoDataset: TAdoDataSet; aCds: TClientDataset): boolean;

implementation

function GetGMTBias: Integer;
var
  info: TTimeZoneInformation;
  Mode: DWord;
begin
  Mode := GetTimeZoneInformation(info);
  Result := info.Bias;
  case Mode of
    TIME_ZONE_ID_INVALID: RaiseLastOSError;
    TIME_ZONE_ID_STANDARD: Result := Result + info.StandardBias;
    TIME_ZONE_ID_DAYLIGHT: Result := Result + info.DaylightBias;
  end;
end;

function GMTNow: TDateTime;
var
  TimeRec: TSystemTime;
begin
  GetSystemTime(TimeRec);
  Result := SystemTimeToDateTime(TimeRec);
end;

function LocaleToGMT(const Value: TDateTime): TDateTime;
begin
  Result := Value + (GetGMTBias / MinsPerDay);
end;

function GMTToLocale(const Value: TDateTime): TDateTime;
begin
  Result := Value - (GetGMTBias / MinsPerDay);
end;

procedure FreeAndNilEx(var Obj);
begin
  if Assigned(Pointer(Obj)) then FreeAndNil(Obj);
end;

function DataToHex(Data: PChar; Len: Integer): string;
begin
  SetLength(Result, Len shl 1);
  BinToHex(Data, PChar(Result), Len);
end;

function IsFileInUse(AName: string): boolean;
var
  hFileRes: HFILE;
begin
  Result := False;
  if not FileExists(AName) then Exit;
  hFileRes := CreateFile(PChar(AName), GENERIC_READ or GENERIC_WRITE, 0,
      nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := (hFileRes = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(hFileRes);
end;

function GetLastErrorText: String;
var
  dwSize: DWORD;
  lpszTemp: PChar;
begin
  dwSize := 512;
  lpszTemp := StrAlloc(dwSize);
  try
    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ARGUMENT_ARRAY,
      nil, GetLastError, LANG_NEUTRAL, lpszTemp, dwSize, nil);
  finally
    Result := String(lpszTemp);
    StrDispose(lpszTemp);
  end;
end;

function GetADOLastErrorText(AdoConn: TAdoConnection): string;
var
  i: integer;
  Err: TStringList;
begin
  Result := '';
  try
    if AdoConn.Errors.Count > 0 then
    begin
      Err := TStringList.Create;
      try
        try
          for i := 0 to AdoConn.Errors.Count - 1 do
            Err.Add(AdoConn.Errors[i].Description);
          Result := Err.Text;
        except

        end;
      finally
        FreeAndNil(Err);
      end;
    end;
  except

  end;
end;

function Encrypt(Src: AnsiString; Key: AnsiString): AnsiString;
var
  KeyLen: integer;
  KeyPos: integer;
  Range:  integer;
  OffSet: integer;
  SrcPos: integer;
  SrcAsc: integer;
  Dest:   AnsiString;
begin
  Result := '';
  if Src = '' then Exit;
  KeyLen := Length(Key);
  if KeyLen = 0 then Key := 'Invalid Key';
  KeyPos := 0;
  Range := 256;
  Randomize;
  OffSet := Random(Range);
  Dest := AnsiString(Format('%1.2x', [OffSet]));
  for SrcPos := 1 to Length(Src) do
  begin
    SrcAsc := (Ord(Src[SrcPos]) + Offset) mod 255;
    if KeyPos < KeyLen then Inc(KeyPos)
    else KeyPos := 1;
    SrcAsc := SrcAsc xor Ord(Key[KeyPos]);
    Dest := Dest + AnsiString(Format('%1.2x', [SrcAsc]));
    OffSet := SrcAsc;
  end;
  Result := Dest;
end;

function Decrypt(Src: AnsiString; Key: AnsiString): AnsiString;
var
  KeyLen: integer;
  KeyPos: integer;
  OffSet: integer;
  SrcPos: integer;
  SrcAsc: integer;
  TmpSrcAsc: integer;
  Dest:   AnsiString;
begin
  Result := '';
  if Src = '' then Exit;
  KeyLen := Length(Key);
  if KeyLen = 0 then Key := 'Invalid Key';
  KeyPos := 0;
  OffSet := System.SysUtils.StrToInt('$'+ string(copy(Src, 1, 2)));
  SrcPos :=3;
  repeat
    SrcAsc := System.SysUtils.StrToInt('$'+ string(copy(Src, SrcPos, 2)));
    if KeyPos < KeyLen then Inc(KeyPos)
    else KeyPos := 1;
    TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
    if TmpSrcAsc <= OffSet then
      TmpSrcAsc := 255 + TmpSrcAsc - OffSet
    else
      TmpSrcAsc := TmpSrcAsc - OffSet;
    Dest := Dest + AnsiString(TmpSrcAsc);
    OffSet := SrcAsc;
    Inc(SrcPos, 2);
  until SrcPos >= Length(Src);
  Result := Dest;
end;

function UnicodeToAnsi(const Src: WideString; CodePage: Word=0): AnsiString;
var
  i, cp: integer;
begin
  Result := '';
  if Src = '' then Exit;
  if CodePage = 0 then
    cp := GetACP
  else
    cp := CodePage;
  i := WideCharToMultiByte(cp, WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS
    or WC_DEFAULTCHAR, @Src[1], -1, nil, 0, nil, nil);
  SetLength(Result, i - 1);
  if i > 1 then
    WideCharToMultiByte(cp, WC_COMPOSITECHECK or WC_DISCARDNS or WC_SEPCHARS or
      WC_DEFAULTCHAR,@Src[1],-1,@Result[1], i - 1,nil,nil);
end;

function AnsiToUnicode(const Src: AnsiString; CodePage: Word=0): WideString;
var
  i, cp: integer;
begin
  Result := '';
  if Src = '' then Exit;
  if CodePage = 0 then
    cp := GetACP
  else
    cp := CodePage;
  i := MultiByteToWideChar(cp, MB_PRECOMPOSED, PAnsiChar(@Src[1]), -1, nil, 0);
  SetLength(Result, i - 1);
  if i > 1 then
    MultiByteToWideChar(cp, MB_PRECOMPOSED, PAnsiChar(@Src[1]), -1, PWideChar(@Result[1]), i - 1);
end;

function IsIPInstalled : boolean;
var
  ProtoEnt: PProtoEnt;
begin
  ProtoEnt := GetProtoByName('IP');
  result:=(ProtoEnt <> nil);
end;

function GetIPFromName(AHostName: AnsiString; var IP: Ansistring): Boolean;
var
   HostName: array [0..255] of ansichar;
   HostEnt: PHostEnt;
   Addr: PAnsiChar;
begin
  Result := False;
  try
    System.AnsiStrings.StrPCopy(HostName, AHostName);
    HostEnt := GetHostByName(HostName);
    if Assigned(HostEnt) then
    begin
      if Assigned(HostEnt^.h_addr_list) then
      begin
        Addr := HostEnt^.h_addr_list^;
        if Assigned(Addr) then
        begin
          IP := Format('%d.%d.%d.%d', [Byte(Addr[0]), Byte(Addr[1]),
            Byte(Addr[2]), Byte(Addr[3])]);
          Result := True;
        end;
      end;
    end;
  except

  end;
end;

function GetNameFromIP(IPAddr: AnsiString; var MacName: AnsiString): Boolean;
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
begin
  Result := False;
  if IPAddr = '' then Exit;
  try
    SockAddrIn.sin_addr.s_addr := inet_addr(PAnsiChar(AnsiString(IPAddr)));
    HostEnt := GetHostByaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
    if HostEnt <> nil then
      MacName := System.AnsiStrings.StrPas(Hostent^.h_name)
    else
      MacName := '';
    Result := (MacName <> '');
  except

  end;
end;

function LanConnected: Boolean;
begin
  Result := False;
  if GetSystemMetrics(SM_NETWORK) <> 0 then
    Result := True;
end;

function InternetConnected: Boolean;
const
  INTERNET_CONNECTION_MODEM = 1;
  INTERNET_CONNECTION_LAN = 2;
  INTERNET_CONNECTION_PROXY = 4;
  INTERNET_CONNECTION_MODEM_BUSY = 8;
var
  dwConnectionTypes: DWORD;
begin
  dwConnectionTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
  Result := InternetGetConnectedState(@dwConnectionTypes, 0);
end;

function UDPPortInuse(Port: integer): Boolean;
var
  s: TSocket;
  SockAddrIn: TSockAddrIn;
begin
  s := Socket(AF_INET, SOCK_DGRAM, 0);
  Result := True;
  try
    if (s <> SOCKET_ERROR) then
    begin
      SockAddrIn.sin_family := AF_INET;
      SockAddrIn.sin_addr.S_addr := htonl(INADDR_ANY);
      SockAddrIn.sin_port := htons(Port);
      Result := Bind(s, SockAddrIn, SizeOf(SockAddrIn)) <> 0;
    end;
  finally
    CloseSocket(s);
  end;
end;

function TCPPortInuse(Port: integer): Boolean;
var
  s: TSocket;
  SockAddrIn: TSockAddrIn;
begin
  s := Socket(AF_INET, SOCK_STREAM, 0);
  Result := True;
  try
    if (s <> SOCKET_ERROR) then
    begin
      SockAddrIn.sin_family := AF_INET;
      SockAddrIn.sin_addr.S_addr := htonl(INADDR_ANY);
      SockAddrIn.sin_port := htons(Port);
      Result := Bind(s, SockAddrIn, SizeOf(SockAddrIn)) <> 0;
    end;
  finally
    CloseSocket(s);
  end;
end;

function GetRandomUDPPort(RangeMin: integer; RangeMax: integer): Integer;
var
   i,j: integer;
   SockHandle: TSocket;
   Addr: TSockAddr;
begin
  Result := 0;
  SockHandle := Socket(AF_INET, SOCK_DGRAM, 0);
  if SockHandle = SOCKET_ERROR then Exit;
  for i := RangeMin to RangeMax do
  begin
    j := Random(RangeMax - RangeMin) + RangeMin;
    Addr.sin_family := AF_INET;
    Addr.sin_addr.s_addr := INADDR_ANY;
    Addr.sin_port := htons(j);
    if bind(SockHandle, Addr, SizeOf(Addr)) = SOCKET_ERROR then
      Continue;
    CloseSocket(SockHandle);
    Result := j;
    Break;
  end;
end;

function GetRandomTCPPort(RangeMin: integer; RangeMax: integer): Integer;
var
   i,j: integer;
   SockHandle: TSocket;
   Addr: TSockAddr;
begin
  Result := 0;
  SockHandle := Socket(AF_INET, SOCK_STREAM, 0);
  if SockHandle = SOCKET_ERROR then Exit;
  for i := RangeMin to RangeMax do
  begin
    j := Random(RangeMax - RangeMin) + RangeMin;
    Addr.sin_family := AF_INET;
    Addr.sin_addr.s_addr := INADDR_ANY;
    Addr.sin_port := htons(j);
    if bind(SockHandle, Addr, SizeOf(Addr)) = SOCKET_ERROR then
      Continue;
    CloseSocket(SockHandle);
    Result := j;
    Break;
  end;
end;

function GetLocalIP(): AnsiString;
var
  HostEnt: PHostEnt;
  IP: String;
  Addr: PAnsiChar;
  Buffer: array [0..63] of AnsiChar;
begin
  Result := '0.0.0.0';
  GetHostName(Buffer, SizeOf(Buffer));
  HostEnt := GetHostByName(Buffer);
  if HostEnt = nil then Exit;
  Addr:= HostEnt^.h_addr_list^;
  Result := AnsiString(Format('%d.%d.%d.%d ', [Byte(Addr[0]), Byte(Addr[1]),
    Byte(Addr[2]), Byte(addr[3])]));
end;

function GetComputerName: String;
var
  FStr: PChar;
  FSize: Cardinal;
begin
  FSize := 255;
  GetMem(FStr, FSize);
  Winapi.Windows.GetComputerName(FStr, FSize);
  Result := FStr;
  FreeMem(FStr);
end;

function GetLocalIpList(var IpList: TStringList):Integer;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  HostName : array [0..MAX_PATH] of Ansichar;
  NameLen: Integer;
  lpHostEnt: PHostEnt;
  i: Integer;
  pptr: PaPInAddr;
begin
  Result := 0;
  NameLen := Sizeof(HostName);
  FillChar(HostName, NameLen, 0);
  NameLen := GetHostName(HostName, NameLen);
  if NameLen = SOCKET_ERROR then Exit;
  lpHostEnt := GetHostByName(HostName);
  if lpHostEnt = nil then Exit;
  i := 0;
  pPtr := PaPInAddr(lpHostEnt^.h_addr_list);
  IpList.Clear;
  while pPtr^[I] <> nil  do
  begin
    IpList.ADD(String(System.AnsiStrings.StrPas(inet_ntoa(pptr^[I]^))));
    Inc(i);
  end;
  Result := IpList.Count;
end;

function IsValidIP(aStrIP: AnsiString): Boolean;
var
  iCount: Integer;
  iIPLength: Integer;
  iFieldLength: Integer;
  iFieldStart: Integer;
  iDotCount: Integer;
  strTemp: AnsiString;
begin
  Result := False;
  iIPLength := Length(astrIP);
  if (iIPLength > 15) or (iIPLength < 7) or (aStrIP = '0.0.0.0') then Exit;
  iDotCount := 0;
  iFieldLength := 0;
  iFieldStart := 1;
  try
    for iCount:=1 to iIPLength do
    begin
      case aStrIP[iCount] of
      '0','1','2','3','4','5','6','7','8','9':
      begin
        iFieldLength := iFieldLength + 1;
        if 3 < iFieldLength then Exit;
      end;
      '.':
      begin
        if 0 = iFieldLength then Exit;
        strTemp := Copy(astrIp, iFieldStart, iCount - iFieldStart);
        if 255 < System.SysUtils.StrToInt(strTemp) then Exit;
        iDotCount:=iDotCount+1;
        if 3 < iDotCount then Exit;
        iFieldLength := 0;
        iFieldStart := iCount + 1;
      end;
      end;
    end;
    Result := True;
  except

  end;
end;

function HostIsOnline(IpAddr: string): Boolean;
type
  PIPOptionInformation = ^TIPOptionInformation;
  TIPOptionInformation = packed record
     TTL:         Byte;      // Time To Live (used for traceroute)
     TOS:         Byte;      // Type Of Service (usually 0)
     Flags:       Byte;      // IP header flags (usually 0)
     OptionsSize: Byte;      // Size of options data (usually 0, max 40)
     OptionsData: PChar;     // Options data buffer
  end;
  PIcmpEchoReply = ^TIcmpEchoReply;
  TIcmpEchoReply = packed record
     Address:       DWord;                // replying address
     Status:        DWord;                // IP status value (see below)
     RTT:           DWord;                // Round Trip Time in milliseconds
     DataSize:      Word;                 // reply data size
     Reserved:      Word;
     Data:          Pointer;              // pointer to reply data buffer
     Options:       TIPOptionInformation; // reply options
  end;
  TIcmpCreateFile = function: THandle; stdcall;
  TIcmpCloseHandle = function(IcmpHandle: THandle): Boolean; stdcall;
  TIcmpSendEcho = function(
     IcmpHandle:          THandle;
     DestinationAddress:  DWord;
     RequestData:         Pointer;
     RequestSize:         Word;
     RequestOptions:      PIPOptionInformation;
     ReplyBuffer:         Pointer;
     ReplySize:           DWord;
     Timeout:             DWord): DWord; stdcall;
const
  Size = 32;
  TimeOut = 1000;
var
  Address: DWord;
  HostName: Ansistring;
  HostIP: AnsiString;
  Phe: PHostEnt;
  BufferSize, nPkts: Integer;
  pReqData, pData: Pointer;
  pIPE: PIcmpEchoReply;
  IPOpt: TIPOptionInformation;
const
  IcmpDLL = 'icmp.dll';
var
  hICMPlib: HModule;
  IcmpCreateFile : TIcmpCreateFile;
  IcmpCloseHandle: TIcmpCloseHandle;
  IcmpSendEcho:    TIcmpSendEcho;
  hICMP: THandle;
begin
  Result:=True;
  hICMPlib := loadlibrary(icmpDLL);
  if hICMPlib <> 0 then
    begin
      @ICMPCreateFile := GetProcAddress(hICMPlib, 'IcmpCreateFile');
      @IcmpCloseHandle:= GetProcAddress(hICMPlib, 'IcmpCloseHandle');
      @IcmpSendEcho:= GetProcAddress(hICMPlib, 'IcmpSendEcho');
      if (@ICMPCreateFile = Nil) or (@IcmpCloseHandle = Nil) or (@IcmpSendEcho = Nil) then
      begin
        Result := False;
        Halt;
      end;
      hICMP := IcmpCreateFile;
      if hICMP = INVALID_HANDLE_VALUE then
      begin
        Result := False;
        Halt;
      end;
    end
  else
    begin
      Result:=False;
      Halt;
    end;
  Address := inet_addr(PAnsiChar(AnsiString(IpAddr)));
  if Address = INADDR_NONE then
    begin
      Phe := GetHostByName(PAnsiChar(AnsiString(IpAddr)));
      if Phe = nil then
        Result := False
      else
        begin
          Address := longint(plongint(Phe^.h_addr_list^)^);
          HostName := Phe^.h_name;
          HostIP := System.AnsiStrings.StrPas(inet_ntoa(TInAddr(Address)));
        end;
    end
  else
    begin
      Phe := GetHostByAddr(@Address, 4, PF_INET);
      if Phe = nil then
        Result := False;
    end;
  if Address = INADDR_NONE then
    Result := False;
  BufferSize := SizeOf(TICMPEchoReply) + Size;
  GetMem(pReqData, Size);
  GetMem(pData, Size);
  GetMem(pIPE, BufferSize);
  FillChar(pReqData^, Size, $AA);
  pIPE^.Data := pData;
  FillChar(IPOpt, SizeOf(IPOpt), 0);
  IPOpt.TTL := 64;
  NPkts := IcmpSendEcho(hICMP, Address, pReqData, Size,
    @IPOpt, pIPE, BufferSize, TimeOut);
  if NPkts = 0 then
     Result := False;
  FreeMem(pIPE);
  FreeMem(pData);
  FreeMem(pReqData);
  IcmpCloseHandle(hICMP);
  FreeLibrary(hICMPlib);
end;

function GetConnectionKind: integer;
const
  MODEM = 1;
  LAN = 2;
  PROXY = 4;
  BUSY = 8;
var
  Flags: DWORD;
  OK: boolean;
begin
  Result:=0;
  OK := InternetGetConnectedState(@Flags, 0);
  if OK then
  begin
    if (Flags and MODEM) = MODEM then
      Result:=1;
    if (Flags and LAN) = LAN then
      Result:=2;
    if (Flags and PROXY) = PROXY then
      Result:=4;
    if (Flags and BUSY) = BUSY then
      Result:=8;
  end;
end;

procedure DeleteDirectory(sDir: String);
var
   sr: TSearchRec;
   sPath,sFile: String;
begin
  if Copy(sDir,Length(sDir),1) <> '\' then
    sPath := sDir + '\'
  else
    sPath:=sDir;
  if System.SysUtils.FindFirst(sPath + '*.*', faAnyFile, sr) = 0 then
  begin
    repeat
      sFile:=Trim(sr.Name);
      if sFile= '.' then
        Continue;
      if sFile= '..' then
        Continue;
      sFile := sPath + sr.Name;
      if (sr.Attr and faDirectory) <> 0 then
        DeleteDirectory(sFile)
      else
        begin
          if (sr.Attr and faAnyFile)=sr.Attr then
            DeleteFile(sFile);
        end;
    until System.SysUtils.FindNext(sr) <> 0;
    System.SysUtils.FindClose(sr);
  end;
  RemoveDir(sPath);
end;

function VariantToStream (const v: OleVariant; Stream: TMemoryStream): Boolean;
var
  p: Pointer;
  tmpstr: String;
begin
  if VarIsArray(v) then
    begin
      try
        Stream.Position := 0;
        Stream.Size := VarArrayHighBound(v, 1) - VarArrayLowBound(v, 1) + 1;
        p := VarArrayLock(v);
        Stream.Write(p^, Stream.Size);
        VarArrayUnlock(v);
        Stream.Position:=0;
        Result := True;
      except
        Stream.Clear;
        Result := False;
      end;
    end
  else
    begin
      if not VarIsNull(V) then
        begin
          tmpstr := VarToStr(v);
          Stream.Write(tmpstr[1], Length(tmpstr) * SizeOf(char));
          Stream.Position := 0;
        end
      else
        Stream.Clear;
      Result := True;
    end;
end;

function StreamToVariant(Stream: TMemoryStream; var v: OleVariant): Boolean;
var
  p: Pointer;
begin
  try
    v := VarArrayCreate([0, Stream.Size - 1], varByte);
    p := VarArrayLock(v);
    Stream.Position := 0;
    Stream.Read(p^, Stream.Size);
    VarArrayUnlock(v);
    Result := True;
  except
    Result := False;
  end;
end;

function RecordsetToStream(const RecordSet: _Recordset; var Stream: TMemoryStream): Boolean;
var
  rs: OleVariant;
begin
  Result := False;
  Stream.Clear;
  if RecordSet = nil then Exit;
  try
    rs := CreateOleObject('ADODB.Recordset');
    rs := RecordSet;
    rs.Save(TStreamAdapter.Create(stream) as IUnknown, adPersistADTG);
    rs := unassigned;
    Stream.Position := 0;
    Result := True;
  except

  end;
end;

function StreamToRecordSet(Stream: TMemoryStream; var RecordSet: _Recordset): Boolean;
var
   RS: OleVariant;
begin
  Result := False;
  if Stream.Size < 1 then
  begin
    RecordSet := nil;
    Exit;
  end;
  try
    Stream.Position := 0;
    RS := CreateOleObject('ADODB.Recordset');
    RS.Open(TStreamAdapter.Create(Stream) as IUnknown);
    RecordSet := IUnknown(RS) as _Recordset;
    Result := True;
  except;
    RecordSet := nil;
  end;
end;

function DataSetToCdsData(aDataset: TDataset): OleVariant;
var
  dsp: TDatasetProvider;
begin
  dsp := TDatasetProvider.Create(nil);
  try
    dsp.DataSet := aDataset;
    Result := dsp.Data;
  finally
    FreeAndNil(dsp);
  end;
end;

function GetCdsFromAdo(aAdoDataset: TAdoDataset; aCds: TClientDataset): Boolean;
var
  i: integer;
  Stream: TMemoryStream;
begin
  aCds.Close;
  Stream := TMemoryStream.Create;
  try
    for i := 0 to aAdoDataset.Fields.Count - 1 do
    begin
      with aCds.FieldDefs.AddFieldDef do
      begin
        Name := aAdodataset.Fields[i].FieldName;
        if aAdodataset.Fields[i].DataType = ftAutoInc then
          DataType := ftInteger
        else
          DataType := aAdodataset.Fields[i].DataType;
        if (DataType = ftString) or (DataType = ftWideString)
          or (DataType = ftFixedChar)
          {$IFDEF UNICODE}
          or (DataType = ftFixedWideChar) or (DataType = ftWideMemo)
          {$ENDIF}
          or (DataType = ftMemo) then
          Size := aAdodataset.Fields[i].DataSize;
      end;
    end;
    aCds.CreateDataSet;
    aAdoDataset.First;
    while not aAdoDataset.Eof do
    begin
      aCds.Append;
      for i := 0 to aAdoDataset.Fields.Count - 1 do
      begin
        if aAdoDataset.Fields[i].IsNull then Continue;
        if aAdoDataset.Fields[i].IsBlob then
          begin
            Stream.Clear;
            try
              TBlobField(aAdoDataset.Fields[i]).SaveToStream(Stream);
            except
              Stream.Clear;
            end;
            if Stream.Size > 0 then
            begin
              Stream.Position:=0;
              TBlobField(aCds.Fields[i]).LoadFromStream(Stream);
            end;
          end
        else
          aCds.Fields[i].Value := aAdoDataset.Fields[i].Value;
      end;
      aCds.Post;
      aAdoDataset.Next;
    end;
    Result:=true;
  except
    Result:=false;
  end;
  FreeAndNil(Stream);
end;

end.
